package Bio::Tools::Mlst::Mlstnet;

use base qw(Bio::Tools::Mlst);
use 5.008008;
use strict;
use warnings;
use Data::Dumper;
use LWP::Simple;
use HTML::Entities;

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use MLST ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.
our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

our $VERSION = '0.03';

# TODO allow for the proxy and uri to be changed in case there is a local database
# TODO make some kind of validation for arguments in all subroutines
sub new{
  my($class,$args)=@_;
  my($self);
  
  # default variables for this subroutine, which will eventually affect the rest of the class
  my %default=(database=>'spneumoniae');
  
  $self={
    defaultVar=>\%default
  };
  bless($self, $class);
  
  # default arguments for the rest of the class
  if(!defined($$args{database})){
    # set default database and therefore a default repository down the line
    $$args{database}=$self->{defaultVar}->{database};
  }
  $self->_setDefaultArguments($args);
  $args=$self->_processArgs($args);
    
  return $self;
}

sub getProfileListURL{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my $URL="http://".$$args{database}.".mlst.net/sql/st_tab.asp";
  return $URL;
}
sub getAlleleSequencesURL{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my $database=$$args{database};
  my $locus=$$args{locus};
  my $URL="http://$database.mlst.net/sql/fasta.asp?allele=$locus";
  return $URL;
}
sub getLocusList{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my $URL='http://'.$$args{database}.'.mlst.net/sql/download_alleles.asp';
  my $content=get($URL) or die("Error while trying to get $URL: $!\n");
  my %locus=();
  #print "$content\n";exit;
  while($content=~/<option[^>]*>(.+?)</gi){
    $locus{$1}++;
  }
  my @locus=keys(%locus);
  @locus=sort {
    # apparently ddl_ is the last locus
    if($a eq 'ddl_'){
      return 1;
    }
    # otherwise we have an alphabetical order
    return $a cmp $b;
  } @locus;
  return @locus;
}
sub getProfileCount{
  my($self,$args)=@_;
  $self->debug("Warning: getProfileCount also counts skipped ST numbers.\n");
  $args=$self->_processArgs($args);
  my @ST=$self->_getProfileArray($args);
  my $count=@ST;
  $count--; # remove the extra that was added when converting to 1-based coordinates
  return $count;
}
# TODO sub getProfile
sub getProfile{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my @ST=$self->_getProfileArray($args);
  print Dumper @ST;exit;
  my $profile=$ST[$$args{ST}];
  return %$profile;
}
sub getAllele{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my %seq=$self->_getAlleleArray($args);
  my $id=join("",($$args{locus},$$args{allele}));
  return $seq{$id};
}

# Returns an array of results. 
# Because mlst.net does not have their own BLAST, it will run locally
# http://www.bioperl.org/wiki/HOWTO:SearchIO
# TODO allow for a local database directory parameter (dbDirectory) or database path (dbPath)
sub blast{
  use Bio::Tools::Run::StandAloneBlast;
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my(@result);
  # need to know the database to blast against and also the query sequence.
  my $dbPath=$self->_getMlstnetDb($args);
  
  # Get array of Seq object(s).
  my $query=$$args{sequence};
  my $seqio=$self->_sequenceToSeqIO($query);
  my (@seq);
  while(my $seq=$seqio->next_seq){
  	push(@seq,$seq);
  }
  my $numQueries=@seq;
  
  # blast against the database and make an array of hits
  my @params=(program=>'blastn',database=>$dbPath,b=>$$args{numresults},v=>$$args{numresults});
  my $blast=Bio::Tools::Run::StandAloneBlast->new(@params);
  # TODO if you get a warning because the database isn't formatted, format it!
  for(my $i=0;$i<$numQueries;$i++){
    my $report=$blast->blastall($seq[$i]);
    # loop through each query (there's only 1 because we're already looping through @seq)
    while(my $result=$report->next_result){
      push(@result,$result);
    }
  }  
  # return array of results
  return @result;
}
# return the number of alleles in a locus
sub getAlleleCount{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my $dbPath=$self->_getMlstnetDb($args);  
  # count the number of alleles in the database
  my $seqIO=Bio::SeqIO->new(-format=>"fasta",-file=>$dbPath);
  #count
  my $count;
  while($seqIO->next_seq){
    $count++;
  }
  return $count;
}
################ internal #############
# Download a locus database, formatdb it, and return its path
sub _getMlstnetDb{
  my($self,$args)=@_;
  $args=$self->_processArgs($args);
  my $locus=$$args{locus};
  my $dbName="$locus.fna";
  my $dbPath=$self->_tempDir.$self->{dirSeparator}.$dbName;
  # if the db doesn't exist, then create it
  my $dbContent="";
  if(!$self->_tempFileExists({file=>$dbName})){
  	my $database=$$args{database};
  	my $URL=$self->getAlleleSequencesURL($args);
  	my $page=get($URL);
  	if(!head($URL)){
  	  $self->_error("Could not retrieve the $locus database because an error is being thrown from $URL");
  	}
  	if($page=~/<textarea[^>]*>((.|\n)+)<\/textarea>/i){
  	  $dbContent=$1;
  	  $dbContent=decode_entities($dbContent);
  	  $dbContent=~s/\s*\n+\s*/\n/g; # remove double lines
  	}
  	else{
  	  $self->_error("Could not retrieve $locus database (the given URL for the database was $URL).\n");
  	}
  	$self->_writeTempFile({file=>$dbName,content=>$dbContent});
  	$self->_formatDb($dbPath);
  }
  # if the database already exists
  else{
    #$dbContent=$self->_readTempFile({file=>$dbName});
  }
  return $dbPath;
}
# format a given database given its path
sub _formatDb{
  use File::Copy;
  use File::Basename;
  my($self,$dbPath)=@_;
  # get the basename of the path
  my($basename, $directories) = fileparse($dbPath);
  # Formatdb the database.
  # It will never be protein because MLST is a DNA sequencing method.
  # Indexing is a must because it will be queried, and each sequence id is unique
  my $command="formatdb -o T -p F -i $dbPath";
  eval { 
    # TODO keep errors from going to the screen
    #open (STDERR,">&STDOUT");
    my $a=`$command`;
    #close STDERR;
    return $a;
  };
  # print out any errors or warnings and die
  if($@ || $!){
    my $err=$@||$!;
    $self->_error("$!\n$@\n\nFormatdb warning when running\n  $command\nError was $err");
  }
  # move the formatdb output to the temp directory
  # Also move the formatdb.log file
  File::Copy::mv("formatdb.log",$self->_tempDir);
  File::Copy::mv("$basename"."*",$self->_tempDir);
  # return the path of the database
  return $dbPath;
}
sub _getAlleleArray{
  use Bio::SeqIO;
  use IO::String;
  my($self,$args)=@_;
  # TODO if locus changes in this object, clear $self->{seq}
  if($self->{seq}){
    my $s=$self->{seq};
    return %$s;
  }
  my $URL='http://'.$$args{database}.'.mlst.net/sql/fasta.asp?allele='.$$args{locus};
  my $content=get($URL);
  my $fasta=">No_results\nNNN"; # default sequence
  if($content=~/<textarea[^>]+>((.|\n)+?)</i){
    my $htmlFasta=$1;
    $fasta=$htmlFasta;
    $fasta=~s/&gt;/>/g; # change htmlentities back to symbols
  }
  else{
    print "$content\n";
    $self->throw("Could not get allele list for ".$$args{locus}.".\n");
  }
  my $stringfh = new IO::String($fasta);
  my $seqio=Bio::SeqIO->new(-format=>'fasta',-fh=> $stringfh);
  my %seq;
  while(my $seq=$seqio->next_seq){
    $seq{$seq->id}=$seq;
  }
  $self->{seq}=\%seq;
  return %seq;
}
# get an array of profiles.  Profiles are hashes.
sub _getProfileArray{
  my($self,$args)=@_;
  my (@ST);
  # if the ST array already exists, just grab it and run
  # TODO if the database changes, then clear $self->{ST}
  if($self->{'ST'}){
    my $st=$self->{'ST'};
    @ST=@$st;
    return @ST;
  }
  my $URL=$self->getProfileListURL();
  my $content=get($URL) or die("Error while trying to get $URL: $!\n");
  # This is supposed to be a tsv but it's really HTML with newlines
  # really as <br> tags.
  my @profile=split(/<br>/,$content);
  unshift(@profile,'null value here'); # convert to 1 based coordinates
  my $numProfiles=@profile;
  my @locus=$self->getLocusList($args);
  my $numLoci=@locus;
  for(my $i=1;$i<=$numProfiles;$i++){
    my %profile=();
    if(!$profile[$i]){
      next;
    }
    my @value=split(/\s+/,$profile[$i]);
    my $ST=shift(@value); # shift away the ST
    # generate the profile for this ST
    for(my $j=0;$j<$numLoci;$j++){
      $profile{$locus[$j]}=$value[$j];
    }
    $ST[$ST]=\%profile;
  }
  # see which indices are undefined
  my $num=@ST;
  for(my $i=0;$i<$num;$i++){
    if(!$ST[$i]){
      # make it a null profile with zeros
      for(my $j=0;$j<$numLoci;$j++){
        $ST[$i]{$locus[$j]}=0;
      }
    }
  }
  $self->{'ST'}=\@ST;
  return @ST;
}

1;

__END__

=head1 NAME

Mlstnet - Perl extension for www.mlst.net

=head1 SYNOPSIS

  

=head1 DESCRIPTION


=head2 EXPORT

None by default.



=head1 SEE ALSO

http://www.mlst.net

=head1 AUTHOR

Lee, <lt>lskatz@gatech.edu<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2009 by Lee Katz

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.


=cut
